home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / VDIATTRI.I < prev    next >
Encoding:
Modula Implementation  |  1993-12-10  |  10.3 KB  |  397 lines
  1. IMPLEMENTATION MODULE VDIAttributes;
  2. (*$L-, N+, Y+*)
  3.  
  4.  
  5. (*  MEGAMAX MODULA 2 GEM-Library :  Die VDI Attributfunktionen
  6.  *
  7.  *  Autor: Manuel Chakravarty           Erstellt :  04.11.87
  8.  *
  9.  *  Version   2.2     V#0032
  10.  *)
  11.  
  12. (*  04.11.87    | Übernahme aus 'GEMBase' und 'GEMExt'
  13.  *  01.02.90    | Anpassung auf Compilerversion 4.0 (SET's verdreht)
  14.  *  13.02.90    | 'SetAbsTHeight' setzt 'errNum' korrekt
  15.  *  02.04.90    | Anpassung auf public arrays
  16.  *  25.02.91 TT | "error"-Setzung über occured-Funktion
  17.  *  09.04.91 TT | SetAbsTHeight/SetPtsTHeight: Return-Parms vertauscht
  18.  *  01.08.91 TT | DefUserFill geht nun (enthielt gleich zwei Fehler).
  19.  *  22.05.93 TT | SetAbsTHeight/SetPtsTHeight: keine GemError-Abfrage mehr
  20.  *)
  21.  
  22.  
  23. FROM    SYSTEM          IMPORT ASSEMBLER, WORD;
  24.  
  25. FROM    GrafBase        IMPORT WritingMode;
  26.  
  27. FROM    GEMGlobals      IMPORT LineType, MarkerType, FillType, TEffectSet,
  28.                                LineEnding, THorJust, TVertJust;
  29.  
  30. IMPORT  GEMShare;
  31.  
  32. FROM    GEMEnv          IMPORT DeviceHandle;
  33.  
  34. (*$I GEMOPS.ICL *)
  35.  
  36.  
  37. PROCEDURE SetWritingMode(handle:DeviceHandle;mode:WritingMode);
  38.  
  39. BEGIN
  40.   ASSEMBLER
  41.     MOVE.W      -(A3),D0
  42.     ADDQ.W      #1,D0
  43.     MOVE.L      pubs,A0
  44.     MOVE.W      D0,pubArrays.vINTIN(A0)
  45.     MOVE.W      #SET_WRITING_MODE,(A3)+
  46.     CLR.W       (A3)+
  47.     JSR         vdi_if
  48.     JSR         testINTOUT0
  49.   END;
  50. END SetWritingMode;
  51.  
  52. PROCEDURE DefineColor(handle:DeviceHandle;color,red,green,blue:CARDINAL);
  53.  
  54. BEGIN
  55.   ASSEMBLER
  56.     MOVE.L      pubs,A0
  57.     LEA         pubArrays.vINTIN+8(A0),A0
  58.     MOVE.L      -(A3),-(A0)
  59.     MOVE.L      -(A3),-(A0)
  60.     MOVE.W      #SET_COLOR_REP,(A3)+
  61.     CLR.W       (A3)+
  62.     JSR         vdi_if
  63.   END;
  64. END DefineColor;
  65.  
  66.  
  67.                 (*  Line Attributs  *)
  68.                 (*  ==============  *)
  69.  
  70. PROCEDURE SetLineWidth(handle:DeviceHandle;width:CARDINAL);
  71.  
  72. BEGIN
  73.   ASSEMBLER
  74.     MOVE.L      pubs,A0
  75.     MOVE.W      -(A3),D0
  76.     MOVE.W      D0,pubArrays.PTSIN(A0)
  77.     CLR.W       pubArrays.PTSIN+2(A0)
  78.     MOVE.W      D0,-(A7)
  79.     MOVE.W      #SET_LINE_WIDTH,(A3)+
  80.     CLR.W       (A3)+
  81.     JSR         vdi_if
  82.     MOVE.W      (A7)+,D0
  83.     MOVE.L      pubs,A0
  84.     CMP.W       pubArrays.PTSOUT(A0),D0
  85.     BEQ         cont            ; error:=(PTSOUT[0]#width)
  86.     JSR         gemErrorOccured
  87. cont
  88.   END;
  89. END SetLineWidth;
  90.  
  91. PROCEDURE SetLineEndings(handle:DeviceHandle;begin,end:LineEnding);
  92.  
  93. BEGIN
  94.   ASSEMBLER
  95.     MOVE.L      pubs,A0
  96.     MOVE.L      -(A3),pubArrays.vINTIN(A0)
  97.     MOVE.W      #SET_LINE_END,(A3)+
  98.     CLR.W       (A3)+
  99.     JSR         vdi_if
  100.   END;
  101. END SetLineEndings;
  102.  
  103. PROCEDURE DefUserLine(handle:DeviceHandle;pattern:WORD);
  104.  
  105. BEGIN
  106.   ASSEMBLER
  107.     MOVE.L      pubs,A0
  108.     MOVE.W      -(A3),pubArrays.vINTIN(A0)
  109.     MOVE.W      #SET_LINE_USER,(A3)+
  110.     CLR.W       (A3)+
  111.     JSR         vdi_if
  112.   END;
  113. END DefUserLine;
  114.  
  115. PROCEDURE SetLineColor(handle:DeviceHandle;color:CARDINAL);
  116.  
  117. BEGIN
  118.   ASSEMBLER
  119.     MOVE.W      -(A3),D0
  120.     MOVE.W      #SET_LINE_COLOR,D1
  121.     JSR         setINT0attribut
  122.   END;
  123. END SetLineColor;
  124.  
  125. PROCEDURE SetLineType(handle:DeviceHandle;type:LineType);
  126.  
  127. BEGIN
  128.   ASSEMBLER
  129.     MOVE.W      -(A3),D0
  130.     ADDQ.W      #1,D0
  131.     MOVE.W      #SET_LINE_TYPE,D1
  132.     JSR         setINT0attribut
  133.   END;
  134. END SetLineType;
  135.  
  136.  
  137.                 (*  Marker Attributs  *)
  138.                 (*  ================  *)
  139.  
  140. PROCEDURE SetMarkerHeight(handle:DeviceHandle;height:CARDINAL);
  141.  
  142. BEGIN
  143.   ASSEMBLER
  144.     MOVE.L      pubs,A0
  145.     MOVE.W      -(A3),D0
  146.     MOVE.W      D0,pubArrays.PTSIN+2(A0)
  147.     CLR.W       pubArrays.PTSIN(A0)
  148.     MOVE.W      D0,-(A7)
  149.     MOVE.W      #SET_MARKER_HEIGHT,(A3)+
  150.     CLR.W       (A3)+
  151.     JSR         vdi_if
  152.     MOVE.W      (A7)+,D0
  153.     MOVE.L      pubs,A0
  154.     CMP.W       pubArrays.PTSOUT+2(A0),D0
  155.     BEQ         cont            ; error:=(PTSOUT[1]#height)
  156.     JSR         gemErrorOccured
  157. cont
  158.   END;
  159. END SetMarkerHeight;
  160.  
  161. PROCEDURE SetMarkerColor(handle:DeviceHandle;color:CARDINAL);
  162.  
  163. BEGIN
  164.   ASSEMBLER
  165.     MOVE.W      -(A3),D0
  166.     MOVE.W      #SET_MARKER_COLOR,D1
  167.     JSR         setINT0attribut
  168.   END;
  169. END SetMarkerColor;
  170.  
  171. PROCEDURE SetMarkerType(handle:DeviceHandle;type:MarkerType);
  172.  
  173. BEGIN
  174.   ASSEMBLER
  175.     MOVE.W      -(A3),D0
  176.     ADDQ.W      #1,D0
  177.     MOVE.W      #SET_MARKER_TYPE,D1
  178.     JSR         setINT0attribut
  179.   END;
  180. END SetMarkerType;
  181.  
  182.                 (*  Text Attributs  *)
  183.                 (*  ==============  *)
  184.  
  185. PROCEDURE SetPtsTHeight (handle:DeviceHandle; height:CARDINAL;
  186.                          VAR charW,charH,cellW,cellH:CARDINAL);
  187.                          
  188. BEGIN
  189.   ASSEMBLER
  190.         MOVE.L  -(A3),-(A7)
  191.         MOVE.L  -(A3),-(A7)
  192.         MOVE.L  -(A3),-(A7)
  193.         MOVE.L  -(A3),-(A7)
  194.         
  195.         MOVE.W  -(A3),D0
  196.         MOVE.W  #SET_TEXT_HEIGHT_PTS,D1
  197.         
  198.         MOVE.L      pubs,A0
  199.         MOVE.W      D0,pubArrays.vINTIN(A0)
  200.         MOVE.W      D1,(A3)+
  201.         CLR.W       (A3)+
  202.         JSR         vdi_if
  203.         
  204.         MOVE.L  pubs,A0
  205.         LEA     pubArrays.PTSOUT(A0),A0
  206.         MOVEQ   #3,D0
  207. loop
  208.         MOVE.L  (A7)+,A1
  209.         MOVE.W  (A0)+,(A1)
  210.         DBF     D0,loop
  211.   END;
  212. END SetPtsTHeight;
  213.  
  214. PROCEDURE SetTBaseLine(handle:DeviceHandle;angle:CARDINAL);
  215.  
  216. BEGIN
  217.   ASSEMBLER
  218.     MOVE.W      -(A3),D0
  219.     MOVE.W      #SET_TEXT_BASELINE,D1
  220.     JSR         setINT0attribut
  221.   END;
  222. END SetTBaseLine;
  223.  
  224. PROCEDURE SetTextFace(handle:DeviceHandle;font:CARDINAL);
  225.  
  226. BEGIN
  227.   ASSEMBLER
  228.     MOVE.W      -(A3),D0
  229.     MOVE.W      #SET_TEXT_FACE,D1
  230.     JSR         setINT0attribut
  231.   END;
  232. END SetTextFace;
  233.  
  234. PROCEDURE SetTAlignment(handle:DeviceHandle;hor:THorJust;vert:TVertJust);
  235.  
  236. BEGIN
  237.   ASSEMBLER
  238.     MOVE.L      pubs,A0
  239.     MOVE.L      -(A3),D0
  240.     MOVE.L      D0,pubArrays.vINTIN(A0)
  241.     MOVE.L      D0,-(A7)
  242.     MOVE.W      #SET_TEXT_ALIG,(A3)+
  243.     CLR.W       (A3)+
  244.     JSR         vdi_if
  245.     MOVE.L      (A7)+,D0
  246.     MOVE.L      pubs,A0
  247.     CMP.L       pubArrays.vINTOUT(A0),D0
  248.     BEQ         cont            ; error:=(vINTOUT[0]#hor)&(vINTOUT[1]#vert)
  249.     JSR         gemErrorOccured
  250. cont
  251.   END;
  252. END SetTAlignment;
  253.  
  254. PROCEDURE SetAbsTHeight (handle:DeviceHandle; height:CARDINAL;
  255.                          VAR charW,charH,cellW,cellH:CARDINAL);
  256.  
  257. BEGIN
  258.   ASSEMBLER
  259.         MOVE.L  -(A3),-(A7)
  260.         MOVE.L  -(A3),-(A7)
  261.         MOVE.L  -(A3),-(A7)
  262.         MOVE.L  -(A3),-(A7)
  263.         
  264.         MOVE.L  pubs,A0
  265.         MOVE.W  -(A3),D0
  266.         MOVE.W  D0,pubArrays.PTSIN+2(A0)
  267.         CLR.W   pubArrays.PTSIN(A0)
  268.         
  269.         MOVE.W  D0,-(A7)
  270.         MOVE.W  #SET_TEXT_HEIGHT_ABS,(A3)+
  271.         CLR.W   (A3)+
  272.         JSR     vdi_if
  273.         MOVE.W  (A7)+,D0
  274.         
  275.         MOVE.L  pubs,A0
  276.         (*
  277.           CMP.W   pubArrays.PTSOUT+2(A0),D0
  278.           BEQ     cont            ; error:=(PTSOUT[1]#height)
  279.           JSR     gemErrorOccured
  280.           MOVE.W  pubArrays.PTSOUT+2(A0), errNum
  281. cont    *)
  282.   
  283.         LEA     pubArrays.PTSOUT(A0),A0
  284.         MOVEQ   #3,D0
  285. loop
  286.         MOVE.L  (A7)+,A1
  287.         MOVE.W  (A0)+,(A1)
  288.         DBF     D0,loop
  289.   END;
  290. END SetAbsTHeight;
  291.  
  292. PROCEDURE SetTextColor(handle:DeviceHandle;color:CARDINAL);
  293.  
  294. BEGIN
  295.   ASSEMBLER
  296.     MOVE.W      -(A3),D0
  297.     MOVE.W      #SET_TEXT_COLOR,D1
  298.     JSR         setINT0attribut
  299.   END;
  300. END SetTextColor;
  301.  
  302. PROCEDURE SetTextEffects(handle:DeviceHandle;effects:TEffectSet);
  303.  
  304. BEGIN
  305.   ASSEMBLER
  306.         MOVEQ   #0,D0
  307.         SUBQ.L  #1, A3
  308.         MOVE.B  -(A3), D0
  309.         MOVE.W  #SET_TEXT_EFFECT,D1
  310.         JSR     setINT0attribut
  311.   END;
  312. END SetTextEffects;
  313.  
  314.  
  315.                 (*  Fill Attributs  *)
  316.                 (*  ==============  *)
  317.  
  318. PROCEDURE DefUserFill(handle:DeviceHandle;pattern:PtrFillPattern);
  319.  
  320. BEGIN
  321.   ASSEMBLER
  322.         MOVE.L  -(A3),A1                ; VAR pattern -> A1
  323.         
  324.         MOVE.L  A1,-(A7)
  325.         SUBQ.L  #2,A7
  326.         MOVE.L  A7,(A3)+
  327.         JSR     setDevice       ; (handle, VAR success)
  328.         TST.W   (A7)+
  329.         MOVE.L  (A7)+,A2        ; verändert CCR nicht!
  330.         BEQ     ende
  331.         
  332.         MOVE.L  our_cb,A0               ; Build up the ctrl-array
  333.         MOVE.W  #SET_FILL_USER,cb.V_CONTRL.opcode(A0)
  334.         CLR.W   cb.V_CONTRL.sptsin(A0)
  335.         MOVE.L  cb.CURDEVICE(A0),A1
  336.         MOVE.W  device.handle(A1),cb.V_CONTRL.handle(A0)
  337.         MOVE.W  (A2)+,D0
  338.         LSL.W   #4,D0                   ; pattern.planes*16 -> D0
  339.         MOVE.W  D0,cb.V_CONTRL.sintin(A0)
  340.         MOVE.L  A0,(A3)+                ; Push 'our_cb' for 'vdi_call'
  341.         MOVE.L  pubs, A0
  342.         LEA     pubArrays.vINTIN(A0),A0
  343.         LSR.W   #1,D0                   ; pattern.planes*8 -> D0
  344.         SUBQ.W  #1,D0                   ; pattern.planes*8-1 -> D0 als Zähler
  345. loop                                    ; new pattern -> vINTIN-Array
  346.         MOVE.L  (A2)+,(A0)+
  347.         DBF     D0,loop
  348.         JSR     vdi_call
  349. ende
  350.   END;
  351. END DefUserFill;
  352.  
  353. PROCEDURE SetFillColor(handle:DeviceHandle;color:CARDINAL);
  354.  
  355. BEGIN
  356.   ASSEMBLER
  357.     MOVE.W      -(A3),D0
  358.     MOVE.W      #SET_FILL_COLOR,D1
  359.     JSR         setINT0attribut
  360.   END;
  361. END SetFillColor;
  362.  
  363. PROCEDURE SetFillType(handle:DeviceHandle;type:FillType);
  364.  
  365. BEGIN
  366.   ASSEMBLER
  367.     MOVE.W      -(A3),D0
  368.     MOVE.W      #SET_FILL_INTERIOR,D1
  369.     JSR         setINT0attribut
  370.   END;
  371. END SetFillType;
  372.  
  373. PROCEDURE SetFillIndex(handle:DeviceHandle;index:CARDINAL);
  374.  
  375. BEGIN
  376.   ASSEMBLER
  377.     MOVE.W      -(A3),D0
  378.     MOVE.W      #SET_FILL_INDEX,D1
  379.     JSR         setINT0attribut
  380.   END;
  381. END SetFillIndex;
  382.  
  383. PROCEDURE SetFillPerimeter(handle:DeviceHandle;visible:BOOLEAN);
  384.  
  385. BEGIN
  386.   ASSEMBLER
  387.     MOVE.W      -(A3),D0
  388.     MOVE.W      #SET_FILL_PERIMETER,D1
  389.     JSR         setINT0attribut
  390.   END;
  391. END SetFillPerimeter;
  392.  
  393. END VDIAttributes.
  394.  
  395.  
  396. (* $FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$00000413$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944$FFF8B944Ç$0000029AT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00001BCD$00001CE9$00001E9B$00000018$00002224$00000257$0000025F$0000029B$00001B39$00001BAA$FFEDDDBE$00001BB0$00001BBA$00001BEE$00000018$00002224áÇâ*)
  397.